home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / l2c-19.exe / DLINE.LSP < prev    next >
Text File  |  1993-06-25  |  68KB  |  2,133 lines

  1. ;;;   DLINE.LSP
  2. ;;;   Copyright (C) 1990-1992 by Autodesk, Inc.
  3. ;;;      
  4. ;;;   Permission to use, copy, modify, and distribute this software 
  5. ;;;   for any purpose and without fee is hereby granted, provided 
  6. ;;;   that the above copyright notice appears in all copies and that 
  7. ;;;   both that copyright notice and this permission notice appear in 
  8. ;;;   all supporting documentation.
  9. ;;;
  10. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  11. ;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  12. ;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  13. ;;;
  14. ;;;   DESCRIPTION
  15. ;;;     
  16. ;;;     This is a general purpose "double-line/arc" generator.  It performs 
  17. ;;;     automatic corner intersection cleanups, as well as a number of other 
  18. ;;;     features described below.
  19. ;;;  
  20. ;;;     The user is prompted for a series of endpoints.  As they are picked 
  21. ;;;     "DLINE"  segments are drawn on the current layer.  Options are 
  22. ;;;     available for changing the Width of the DLINE, specifying whether
  23. ;;;     or not to Snap to existing lines or arcs, whether or not to 
  24. ;;;     Break the lines or arcs when snapping to them, and which of the 
  25. ;;;     following to do:  
  26. ;;;     
  27. ;;;     Set the global variable dl:ecp to the values listed below:
  28. ;;;  
  29. ;;;     Value  Meaning
  30. ;;;     ---------------------------
  31. ;;;       0    No end caps
  32. ;;;       1    Start end cap only
  33. ;;;       2    Ending end cap only
  34. ;;;       3    Both end caps
  35. ;;;       4    Auto ON -- Cap any end not on a line or arc.
  36. ;;;       
  37. ;;;     The user may choose to back up as far as the beginning of the command 
  38. ;;;     by typing "U" or "Undo", both of which operate as AutoCAD's "UNDO 1" 
  39. ;;;     does.
  40. ;;;     
  41. ;;;     Curved DLINE's are drawn using the AutoCAD ARC command and follow as 
  42. ;;;     closely as possible its command structure for the various options.
  43. ;;;  
  44. ;;;----------------------------------------------------------------------------
  45. ;;;   OPERATION
  46. ;;;
  47. ;;;     The routine is executed, after loading, by typing either DL or DLINE
  48. ;;;     at which time you are presented with the opening line and menu of
  49. ;;;     choices:
  50. ;;;     
  51. ;;;       Dline, Version 1.11, (c) 1990-1992 by Autodesk, Inc.  
  52. ;;;       Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>: 
  53. ;;;     
  54. ;;;     Typing Break allows you to set breaking of lines and arcs found at
  55. ;;;     the start and end points of any segment either ON or OFF.
  56. ;;;     
  57. ;;;       Break Dline's at start and end points?  OFF/<ON>:
  58. ;;;     
  59. ;;;     Typing Caps allows you to specify how the DLINE will be finished 
  60. ;;;     off when exiting the routine, per the values listed above.
  61. ;;;     
  62. ;;;       Draw which endcaps?  Both/End/None/Start/<Auto>:
  63. ;;;       
  64. ;;;     The default of Auto caps an end only if you did not snap to an arc
  65. ;;;     or line.
  66. ;;;     
  67. ;;;     Typing Dragline allows you to set the location of the dragline
  68. ;;;     relative to the centerline of the two arcs or lines to any value
  69. ;;;     between - 1/2 of "tracewid" and + 1/2 of "tracewid".  (There is a
  70. ;;;     local variable you may set if you want to experiment with offsets
  71. ;;;     outside this range;  the results may not be correct, your choice.
  72. ;;;     See the function (dl_sao) for more information.)
  73. ;;;     
  74. ;;;       Set dragline position to Left/Center/Right/<Offset from center = 0.0>:
  75. ;;;     
  76. ;;;     Enter any real number or one of the keywords.  The value in the angle
  77. ;;;     brackets is the default value and changes as you change the dragline
  78. ;;;     position.
  79. ;;;     
  80. ;;;     Offset allows the first point you enter to be offset from a known
  81. ;;;     point.
  82. ;;;     
  83. ;;;       Offset from:  (enter a point)
  84. ;;;       Offset toward:    (enter a point)
  85. ;;;       Enter the offset distance:   (enter a distance or real number)
  86. ;;;  
  87. ;;;     Snap allows you to set the snapping size and turn snapping ON or OFF.
  88. ;;;     
  89. ;;;       Set snap size or snap On/Off.  Size/OFF/<ON>:
  90. ;;;       New snap size (1 - 10):
  91. ;;;     
  92. ;;;     The upper limit may be reset by changing the value of MAXSNP to a 
  93. ;;;     value other than 10.  Higher values may be necessary for ADI display
  94. ;;;     drivers, but generally, you should keep this value somewhere in the 
  95. ;;;     middle of the allowed range for snapping to work most effectively 
  96. ;;;     in an uncluttered drawing, and toward the lower end for a more 
  97. ;;;     cluttered drawing.  You may also use object snap to improve your 
  98. ;;;     aim.
  99. ;;;     
  100. ;;;     This feature allows you to very quickly "snap" to another line or arc, 
  101. ;;;     breaking it at the juncture and performing all of the intersection 
  102. ;;;     cleanups at one time without having to be precisely on the line, i.e., 
  103. ;;;     you can be visually one the line and it will work, or you can use 
  104. ;;;     object snap to be more precise.
  105. ;;;     
  106. ;;;     Undo backs you up one segment in the chain of segments you are drawing,
  107. ;;;     stopping when there are no more segments to be undone.  All of the 
  108. ;;;     necessary points are saved in lists so that the DLINE will close, cap,
  109. ;;;     and continue correctly after any number of undo's.
  110. ;;;     
  111. ;;;     Width prompts you for a new width.
  112. ;;;     
  113. ;;;       New DLINE width <1.0000>:
  114. ;;;       
  115. ;;;     You may enter a new width and continue the DLINE in the same direction
  116. ;;;     you were drawing before;  if you do this, connecting lines from the
  117. ;;;     endpoints of the previous segment are drawn to the start points of 
  118. ;;;     the new segment.
  119. ;;;     
  120. ;;;     If you press RETURN after closing a DLINE or before creating any
  121. ;;;     DLINE's, you will see this message:
  122. ;;;     
  123. ;;;       No continuation point -- please pick a point.  
  124. ;;;       Break/Caps/Dragline/Offset/Snap/Undo/Width/<start point>:  
  125. ;;;     
  126. ;;;     After you pick the first point, you will see this set of options:
  127. ;;;     
  128. ;;;       Arc/Break/CAps/CLose/Dragline/Snap/Undo/Width/<next point>:
  129. ;;;       
  130. ;;;     Picking more points will draw straight DLINE segments until either 
  131. ;;;     RETURN is pressed or the CLose option is chosen.
  132. ;;;     
  133. ;;;     CLose will close the lines if you have drawn at least two segments.
  134. ;;;     
  135. ;;;     Selecting Arc presents you with another set of choices:
  136. ;;;     
  137. ;;;       Break/CAps/CEnter/CLose/Dragline/Endpoint/Line/Snap/Undo/Width/<second point>:
  138. ;;;     
  139. ;;;     All of the options here are the same as they are for drawing straight
  140. ;;;     DLINE's except CEnter, Endpoint, and Line.
  141. ;;;     
  142. ;;;     The default option, CEnter, and Endpoint are modeled after the ARC
  143. ;;;     command in AutoCAD and exactly mimic its operation including all of
  144. ;;;     the subprompts.  Refer to the AutoCAD reference manual for exact usage.
  145. ;;;     
  146. ;;;     The Line option returns you to drawing straight DLINE segments.
  147. ;;;     
  148. ;;;     Snapping to existing LINE's an ARC's accomplishes all of the trimming 
  149. ;;;     and extending of lines and arcs necessary, including cases where arcs 
  150. ;;;     and lines do not intersect.  In these cases a line is drawn from either;
  151. ;;;     a point on the arc at the perpendicular point from the center of the 
  152. ;;;     arc to the line, to the line, or along the line from the centers of the
  153. ;;;     two arcs that do not intersect at the points where this line crosses
  154. ;;;     the two arcs.  In this way, we ensure that all DLINE's can be closed
  155. ;;;     visually.
  156. ;;;     
  157. ;;;     Breaking will not work unless Snapping is turned on.
  158. ;;;     
  159. ;;;----------------------------------------------------------------------------
  160. ;;;  GLOBALS:
  161. ;;;     dl:osd -- dragline alignment offset from center of two lines or arcs.
  162. ;;;     dl:snp -- T if snapping to existing lines and arcs.
  163. ;;;     dl:brk -- T if breaking existing lines and arcs.
  164. ;;;     dl:ecp -- Bitwise setting of caps when exiting.
  165. ;;;     v:stpt -- Continuation point.
  166. ;;;----------------------------------------------------------------------------
  167. ;;;
  168. ;;; ===========================================================================
  169. ;;; ===================== load-time error checking ============================
  170. ;;;
  171.  
  172.   (defun ai_abort (app msg)
  173.      (defun *error* (s)
  174.         (if old_error (setq *error* old_error))
  175.         (princ)
  176.      )
  177.      (if msg
  178.        (alert (strcat " Application error: "
  179.                       app
  180.                       " \n\n  "
  181.                       msg
  182.                       "  \n"
  183.               )
  184.        )
  185.      )
  186.      (exit)
  187.   )
  188.  
  189. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  190. ;;; and then try to load it.
  191. ;;;
  192. ;;; If it can't be found or it can't be loaded, then abort the
  193. ;;; loading of this file immediately, preserving the (autoload)
  194. ;;; stub function.
  195.  
  196.   (cond
  197.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  198.  
  199.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  200.         (ai_abort "DLINE"
  201.                   (strcat "Can't locate file AI_UTILS.LSP."
  202.                           "\n Check support directory.")))
  203.  
  204.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  205.         (ai_abort "DLINE" "Can't load file AI_UTILS.LSP"))
  206.   )
  207.  
  208.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  209.       (ai_abort "DLINE" nil)         ; a Nil <msg> supresses
  210.   )                                    ; ai_abort's alert box dialog.
  211.  
  212. ;;; ==================== end load-time operations ===========================
  213. ;;; Main function
  214.  
  215. (defun dline  (/ strtpt nextpt pt1    pt2    spts   wnames elast
  216.                  uctr   pr     prnum  temp   ans    dir    ipt
  217.                  v      lst    dist   cpt    rad    orad   ftmp
  218.                  spt    ept    pt     en1    en2    npt    cpt1
  219.                  flg    cont   flg2   flgn   ang    tmp    undo_setting
  220.                  brk_e1 brk_e2 bent1  bent2  nn     nnn    
  221.                  dl_osm dl_oem dl_oce dl_opb dl_obm dl_ver 
  222.                  dl_err dl_oer dl_arc fang   MAXSNP ange   
  223.                  savpt1 savpt2 savpt3 savpt4 savpts 
  224.               )
  225.  
  226.   ;; Version number.  Reset this local if you make a change.
  227.   (setq dl_ver "1.11")  
  228.   
  229.   ;; Reset this value higher for ADI drivers.
  230.   (setq MAXSNP 10)              
  231.  
  232.   (setq dl_osm (getvar "osmode")
  233.         dl_oce (getvar "cmdecho")
  234.         dl_opb (getvar "pickbox")
  235.   )
  236.  
  237.   ;;
  238.   ;; Internal error handler defined locally
  239.   ;;
  240.  
  241.   (defun dl_err (s)                   ; If an error (such as CTRL-C) occurs
  242.                                       ; while this command is active...
  243.     (if (/= s "Function cancelled")
  244.       (if (= s "quit / exit abort")
  245.         (princ)
  246.         (princ (strcat "\nError: " s))
  247.       )
  248.     )
  249.     (command "_.UNDO" "_EN")
  250.     (ai_undo_off)
  251.     (if dl_oer                        ; If an old error routine exists
  252.       (setq *error* dl_oer)           ; then, reset it 
  253.     )
  254.     (if dl_osm (setvar "osmode" dl_osm))
  255.     (if dl_opb (setvar "pickbox" dl_opb))
  256.     
  257.     ;; Reset command echoing on error
  258.     (if dl_oce (setvar "cmdecho" dl_oce))      
  259.     (princ)
  260.   )
  261.   
  262.   ;; Set our new error handler
  263.   (if (not *DEBUG*)
  264.     (if *error*
  265.       (setq dl_oer *error* *error* dl_err)
  266.       (setq *error* dl_err)
  267.     )
  268.   )
  269.  
  270.   (setvar "cmdecho" 0)
  271.   (ai_undo_on)                       ; Turn on UNDO
  272.   (command "_.UNDO" "_GROUP")
  273.   (setvar "osmode" 0)
  274.   (if (null dl:opb) (setq dl:opb (getvar "pickbox")))
  275.  
  276.   
  277.   (setq nextpt "Straight")
  278.  
  279.   ;; Get the first segment's start point
  280.  
  281.   (menucmd "s=dline1")
  282.   (graphscr)
  283.   (princ (strcat "\nDline, Version " dl_ver ", (c) 1990-1992 by Autodesk, Inc. "))
  284.   
  285.   (setq cont T)
  286.   (while cont
  287.     (dl_m1)
  288.  
  289.     ;; Ready to draw successive DLINE segments
  290.  
  291.     (dl_m2)
  292.   )
  293.   
  294.   (if dl_osm (setvar "osmode" dl_osm))
  295.   (if dl_opb (setvar "pickbox" dl_opb))
  296.  
  297.   (ai_undo_off)                      ; Return UNDO to initial state
  298.  
  299.   ;; Reset command echoing
  300.   (if dl_oce (setvar "cmdecho" dl_oce))      
  301.   (menucmd "s=s")
  302.   (princ)
  303. )
  304. ;;;
  305. ;;; Main function subsection 1.
  306. ;;;
  307. ;;; dl_m1 == DLine_Main_1
  308. ;;;
  309. (defun dl_m1 ()
  310.   (setq temp T
  311.         uctr nil 
  312.   )
  313.   (if dl_arc
  314.     (setq nextpt "Arc")
  315.     (setq nextpt "Line")
  316.   )
  317.   ;; temp set to nil when a valid point is entered.
  318.   (while temp
  319.     (initget "Break Caps Dragline Offset Snap Undo Width")
  320.     (setq strtpt (getpoint 
  321.       "\nBreak/Caps/Dragline/Offset/Snap/Undo/Width/<start point>: "))
  322.     (cond
  323.       ((= strtpt "Dragline")
  324.         (dl_sao)
  325.       )
  326.       ((= strtpt "Break")
  327.         (initget "ON OFf")
  328.         (setq dl:brk (getkword 
  329.           "\nBreak Dline's at start and end points?  OFf/<ON>: "))
  330.         (setq dl:brk (if (= dl:brk "OFf") nil T))    
  331.       )
  332.       ((= strtpt "Offset")
  333.         (dl_ofs)
  334.       )
  335.       ((= strtpt "Snap")
  336.         (dl_sso)
  337.       )
  338.       ((= strtpt "Undo")
  339.         (princ "\nAll segments already undone. ")
  340.         (setq temp T)
  341.       )
  342.       ((= strtpt "Width")
  343.         (initget 6)
  344.         (dl_snw)
  345.         (setq temp T)
  346.       )
  347.       ((null strtpt)
  348.         (if v:stpt
  349.           (setq strtpt v:stpt
  350.                 temp   nil
  351.           )
  352.           (progn
  353.             (princ "\nNo continuation point -- please pick a point. ")
  354.           )
  355.         )
  356.       )
  357.       ((= strtpt "Caps")
  358.         (endcap)    
  359.       )
  360.       ;; If none of the above, it must be OK to continue - a point has been 
  361.       ;; picked or entered from the keyboard.
  362.       (T
  363.         (setq v:stpt strtpt
  364.               temp   nil
  365.         )
  366.       )
  367.     )
  368.   )
  369. )
  370. ;;;
  371. ;;; Main function subsection 2.
  372. ;;;
  373. ;;; dl_m3 == DLine_Main_2
  374. ;;;
  375. (defun dl_m2 (/ temp)
  376.   (setq spts (list strtpt)
  377.         uctr 0 
  378.   )
  379.   (if dl:snp
  380.     (dl_ved "brk_e1" strtpt)
  381.   )
  382.   ;; Make sure that the offset is not greater than 1/2 of "tracewid", even
  383.   ;; if the user transparently resets it while the command is running.
  384.   (setq temp (/ (getvar "tracewid") 2.0))
  385.   (if (< dl:osd (- temp))
  386.     (setq dl:osd (- temp))
  387.   )
  388.   (if (> dl:osd temp)
  389.     (setq dl:osd temp)
  390.   )
  391.     
  392.   (while (and nextpt (/= nextpt "CLose"))
  393.     (if (/= nextpt "Quit")
  394.       (if dl_arc 
  395.         (progn
  396.           (menucmd "s=dline2")
  397.           (initget 
  398.             "Break CAps CEnter CLose Dragline Endpoint Line Snap Undo Width")
  399.           (setq nextpt (getpoint strtpt (strcat
  400.             "\nBreak/CAps/CEnter/CLose/Dragline/Endpoint/"
  401.             "Line/Snap/Undo/Width/<second point>: "))
  402.           )
  403.         )
  404.         (progn
  405.           (menucmd "s=dline3")
  406.           (initget "Arc Break CAps CLose Dragline Snap Undo Width")
  407.           (setq nextpt (getpoint strtpt
  408.             "\nArc/Break/CAps/CLose/Dragline/Snap/Undo/Width/<next point>: ")
  409.           )
  410.         )
  411.       )
  412.     )
  413.     (setq v:stpt (last spts))
  414.     (cond
  415.       ((= nextpt "Dragline")
  416.         (dl_sao)
  417.       )
  418.       ((= nextpt "Width")
  419.         (dl_snw)
  420.         
  421.       )
  422.       ((= nextpt "Undo")
  423.         (cond
  424.           ;;((= uctr 0) (princ "\nNothing to undo. ") )
  425.           ((= uctr 0) (setq nextpt nil) )
  426.           ((> uctr 0) 
  427.             (command "_.U")
  428.             (setq spts   (dl_lsu spts 1))
  429.             (setq savpts (dl_lsu savpts 2))
  430.             (setq wnames (dl_lsu wnames 2))
  431.             (setq uctr (- uctr 2))
  432.             (setq strtpt (last spts))
  433.           )
  434.         ) 
  435.         (if dl:snp
  436.           (if (= uctr 0)
  437.             (dl_ved "brk_e1" strtpt)
  438.           ) 
  439.         ) 
  440.       )
  441.       ((= nextpt "Break")
  442.         (initget "ON OFf")
  443.         (setq dl:brk (getkword 
  444.           "\nBreak Dline's at start and end points?  OFF/<ON>: "))
  445.         (setq dl:brk (if (= dl:brk "OFf") nil T))    
  446.         
  447.         (if dl:snp
  448.           (dl_ved "brk_e1" strtpt)
  449.         )
  450.         (if dl_arc
  451.           (setq nextpt "Arc")
  452.           (setq nextpt "Line")
  453.         )
  454.       )
  455.       ((= nextpt "Snap")
  456.         (dl_sso)
  457.       )
  458.       ((= nextpt "Arc")
  459.         (setq dl_arc T)               ; Change to Arc segment prompt.
  460.       )
  461.       ((= nextpt "Line")
  462.         (setq dl_arc nil)             ; Change to Line segment prompt.
  463.       )
  464.       ((= nextpt "CLose")
  465.         (dl_cls)
  466.       )
  467.       ((= (type nextpt) 'LIST)
  468.         (dl_ds)
  469.       )
  470.       ((= nextpt "CEnter")
  471.         (dl_ceo)
  472.       )
  473.       ((= nextpt "Endpoint")
  474.         (dl_epo)
  475.       )
  476.       ((= nextpt "CAps")
  477.         (endcap)                      ; Set which caps to draw when exiting.
  478.       )
  479.       (T
  480.         (setq nextpt nil cont nil)
  481.         (if (> uctr 1)
  482.           (if (= (logand 4 dl:ecp) 4)
  483.             (progn
  484.               (if (null brk_e1) (command "_.LINE" savpt1 savpt2 ""))
  485.               (dl_ssp)
  486.               (if (null brk_e2) (command "_.LINE" savpt3 savpt4 ""))
  487.             )
  488.             (progn
  489.               (if (= (logand 1 dl:ecp) 1)
  490.                 (command "_.LINE" savpt1 savpt2 "")
  491.               )
  492.               (if (= (logand 2 dl:ecp) 2)
  493.                 (progn
  494.                   (dl_ssp)
  495.                   (command "_.LINE" savpt3 savpt4 "")
  496.                 )
  497.               )
  498.             )
  499.           )
  500.         )
  501.         (if brk_e1 (setq brk_e1 nil))
  502.         (if brk_e2 (setq brk_e2 nil))
  503.         (command "_.UNDO" "_EN")
  504.       )                               ; end of inner cond  
  505.     )                                 ; end of outer cond  
  506.   )                                   ; end of while
  507. )
  508. ;;; ------------------ End Main Functions ---------------------------
  509. ;;; ---------------- Begin Support Functions ------------------------
  510.  
  511.  
  512. ;;;
  513. ;;; Close the DLINE with either straight or arc segments.  
  514. ;;; If closing with arcs, the minimum number of segments already drawn
  515. ;;; is 1, otherwise it is 2.
  516. ;;;
  517. ;;; dl_cls == DLine_CLose_Segments
  518. ;;;
  519. (defun dl_cls ()
  520.   (if (or (and (null dl_arc) (< uctr 4)
  521.                (if (> uctr 1)
  522.                  (/= (dl_val 0 (entlast)) "ARC")
  523.                  (not (> uctr 1))
  524.                )
  525.           )
  526.           (and dl_arc (< uctr 2)))
  527.     (progn 
  528.       (princ "\nCannot close -- too few segments. ")
  529.       (if dl_arc
  530.         (setq nextpt "Arc")
  531.         (setq nextpt "Line")
  532.       )
  533.     )
  534.     (progn
  535.       (command "_.UNDO" "_GROUP")
  536.       (setq nextpt (nth 0 spts))
  537.       (if (null dl_arc)
  538.         ;; Close with line segments
  539.         (dl_mlf 3)
  540.         (progn
  541.           (setq tmp (last wnames)
  542.                 ange (trans '(1 0 0) (dl_val -1 tmp) 1)
  543.                 ange (angle '(0 0 0) ange)
  544.                 dir (if (= (dl_val 0 tmp) "LINE")
  545.                       (angle (trans (dl_val 10 tmp) 0 1) 
  546.                              (trans (dl_val 11 tmp) 0 1))
  547.                       (progn
  548.                         (setq dir (+ (dl_val 50 tmp) ange)
  549.                               dir (if (> dir (* 2 pi))
  550.                                     (- dir (* 2 pi))
  551.                                     dir
  552.                                   )
  553.                         )
  554.                         (if (equal dir
  555.                                    (setq dir (angle (trans (dl_val 10 tmp) 
  556.                                                            (dl_val -1 tmp) 
  557.                                                            1)
  558.                                                     strtpt
  559.                                              ) 
  560.                                    )
  561.                                    0.01)
  562.                           (- dir (/ pi 2))
  563.                           (+ dir (/ pi 2))
  564.                         )
  565.                       )
  566.                     )
  567.           )
  568.           (command "_.ARC" 
  569.                    strtpt 
  570.                    "_E" 
  571.                    nextpt 
  572.                    "_D"
  573.                    (* dir (/ 180 pi))
  574.           )
  575.           ;; Close with arc segments
  576.           (dl_mlf 4)
  577.         )
  578.       )
  579.       ;; set nextpt to "CLose" which will cause an exit.
  580.       (setq nextpt "CLose"
  581.             v:stpt nil
  582.             cont   nil
  583.       )
  584.     )
  585.   )
  586. )
  587. ;;;
  588. ;;; A point was entered, do either an arc or line segment.
  589. ;;;
  590. ;;; dl_ds == DLine_Do_Segment
  591. ;;;
  592. (defun dl_ds ()
  593.   (if (equal strtpt nextpt 0.0001)
  594.     (progn
  595.       (princ "\nCoincident point -- please try again. ")
  596.       (if dl_arc
  597.         (setq nextpt "Arc")
  598.         (setq nextpt "Line")
  599.       )
  600.     )
  601.     (progn
  602.       (command "_.UNDO" "_GROUP")
  603.       (setq nextpt (list (car nextpt) (cadr nextpt) (caddr strtpt)))
  604.       (if dl_arc
  605.         (progn
  606.           (command "_.ARC" strtpt nextpt)
  607.           (prompt "\nEndpoint: ")
  608.           (command pause)
  609.           (setq nextpt (getvar "lastpoint")
  610.                 v:stpt nextpt)
  611.           (setq temp (entlast))
  612.           ;; Delete the last arc segment so we can find the line or 
  613.           ;; arc under it.
  614.           (entdel temp)
  615.           (if dl:snp
  616.             (dl_ved "brk_e2" nextpt)
  617.           )
  618.           ;; Restore the arc previously deleted.
  619.           (entdel temp)
  620.           ;; Draw the arc segments.
  621.           (dl_mlf 2)
  622.         )
  623.         (progn
  624.           (setq v:stpt nextpt)
  625.           (if dl:snp
  626.             (dl_ved "brk_e2" nextpt)
  627.           )
  628.           (if (and brk_e1 (eq brk_e1 brk_e2) (= (dl_val 0 brk_e1) "LINE"))
  629.             (progn
  630.               (princ "\nSecond point cannot be on the same line segment. ")
  631.               (setq brk_e2 nil)
  632.             )
  633.             ;; Draw the line segments.
  634.             (dl_mlf 1)
  635.           )
  636.         )
  637.       )
  638.       (if brk_e2 (setq nextpt "Quit"))
  639.     )
  640.   )
  641. )
  642. ;;;
  643. ;;; The CEnter option for drawing arc segments was selected.
  644. ;;;
  645. ;;; dl_ceo == DLine_CEnter_Option
  646. ;;;
  647. (defun dl_ceo ()
  648.   (command "_.UNDO" "_GROUP")
  649.   (setq temp T)
  650.   (while temp
  651.     (initget 1)
  652.     (setq cpt (getpoint strtpt "\nCenter point: "))
  653.     (if (<= (distance cpt strtpt) (- (/ (getvar "tracewid") 2.0) dl:osd))
  654.       (progn
  655.         (princ 
  656.         "\nThe radius defined by the selected center point is too small ")
  657.         (princ "\nfor the current Dline width.  ")
  658.         (princ "Please select another point.")
  659.       )
  660.       (setq temp nil)
  661.     )
  662.   )
  663.   ;; Start the ARC command so that we can get visual dragging.
  664.   (command "_.ARC" strtpt "_C" cpt)
  665.   (initget "Angle Length Endpoint")
  666.   (setq nextpt (getkword "\nAngle/Length of chord/<Endpoint>: "))
  667.   (cond 
  668.     ((= nextpt "Angle")
  669.       (prompt "\nIncluded angle: ")
  670.       (command "_A" pause)
  671.       (setq nextpt (dl_vnp)
  672.             v:stpt nextpt
  673.       )
  674.       ;; Draw the arc segments.
  675.       (dl_mlf 2) 
  676.     )
  677.     ((= nextpt "Length")
  678.       (prompt "\nChord length: ")
  679.       (command "_L" pause)
  680.       (setq nextpt (dl_vnp)
  681.             v:stpt nextpt
  682.       )
  683.       ;; Draw the arc segments.
  684.       (dl_mlf 2) 
  685.     )
  686.     (T
  687.       (prompt "\nEndpoint: ")
  688.       (command pause)
  689.       (setq nextpt (dl_vnp)
  690.             v:stpt nextpt
  691.       )
  692.       ;; Draw the arc segments.
  693.       (dl_mlf 2) 
  694.     )
  695.   )
  696. )
  697. ;;;
  698. ;;; Endpoint option was selected.
  699. ;;;
  700. ;;; dl_epo == DLine_End_Point_Option
  701. ;;;
  702. (defun dl_epo ()
  703.   (command "_.UNDO" "_GROUP")
  704.   (initget 1)
  705.   (setq cpt (getpoint "\nEndpoint: "))
  706.   ;; Start the ARC command so that we can get visual dragging.
  707.   (command "_.ARC" strtpt "_E" cpt)
  708.   (initget "Angle Direction Radius Center")
  709.   (setq nextpt (getkword "\nAngle/Direction/Radius/<Center>: "))
  710.   (cond 
  711.     ((= nextpt "Angle")
  712.       (prompt "\nIncluded angle: ")
  713.       (command "_A" pause)
  714.       (setq nextpt (dl_vnp)
  715.             v:stpt nextpt
  716.       )
  717.       ;; Draw the arc segments.
  718.       (dl_mlf 2) 
  719.     )
  720.     ((= nextpt "Direction")
  721.       (prompt "\nTangent direction: ")
  722.       (command "_D" pause)
  723.       (setq nextpt (dl_vnp)
  724.             v:stpt nextpt
  725.       )
  726.       ;; Draw the arc segments.
  727.       (dl_mlf 2) 
  728.     )          
  729.     ((= nextpt "Radius")
  730.       (setq temp T)
  731.       (while temp
  732.         (initget 1)
  733.         (setq rad (getdist cpt "\nRadius: "))
  734.         
  735.         (if (or (<= rad (/ (getvar "tracewid") 2.0))
  736.                 (< rad (/ (distance strtpt cpt) 2.0)))
  737.           (progn
  738.             (princ "\nThe radius entered is less than 1/2 ")
  739.             (princ "of the Dline width or is invalid")
  740.             (princ "\nfor the selected endpoints.  ")
  741.             (princ "Please enter a radius greater than ")
  742.             (if (< (/ (getvar "tracewid") 2.0) 
  743.                    (/ (distance strtpt cpt) 2.0))
  744.               (princ (rtos (/ (distance strtpt cpt) 2.0)))
  745.               (princ (rtos (/ (getvar "tracewid") 2.0)))
  746.             )
  747.             (princ ". ")
  748.           )
  749.           (setq temp nil)
  750.         )
  751.       )
  752.       (command "_R" rad)
  753.       (setq nextpt (dl_vnp)
  754.             v:stpt nextpt
  755.       )
  756.       ;; Draw the arc segments.
  757.       (dl_mlf 2) 
  758.     )
  759.     (T
  760.       (prompt "\nCenter: ")
  761.       (command pause)
  762.       (setq nextpt (dl_vnp)
  763.             v:stpt nextpt
  764.       )
  765.       ;; Draw the arc segments.
  766.       (dl_mlf 2) 
  767.     )
  768.   )
  769. )
  770. ;;;
  771. ;;; Set the ending save points for capping the DLINE.
  772. ;;;
  773. ;;; dl_ssp == DLine_Set_Save_Points
  774. ;;;
  775. (defun dl_ssp ( / temp)
  776.   (setq temp (length savpts))
  777.   (if (> temp 1)
  778.     (progn
  779.       (setq savpt3 (nth (- temp 2) savpts)
  780.             savpt4 (nth (- temp 1) savpts)
  781.       )
  782.     )
  783.   )
  784. )
  785. ;;;
  786. ;;; Set the alignment of the "ghost" line to one of the following values:
  787. ;;;   
  788. ;;;   Left   == -1/2 of width (Real number)
  789. ;;;           > -1/2 of width (Real number)
  790. ;;;   Center == 0.0
  791. ;;;           < +1/2 of width (Real number)
  792. ;;;   Right  == +1/2 of width (Real number)
  793. ;;;
  794. ;;; All of the alignment options are taken as if you are standing at the
  795. ;;; start point of the line or arc looking toward the end point, with 
  796. ;;; left and negative values being on the left, center or 0.0 being
  797. ;;; directly in line, and right or positive on the right.
  798. ;;; 
  799. ;;; Entering a real number equal to 1/2 of the width sets an absolute offset
  800. ;;; distance from the centerline, while specifying the same offset distance
  801. ;;; with the keywords tells the routine to change the offset distance to 
  802. ;;; match 1/2 of the width, whenever it is changed.
  803. ;;;
  804. ;;; NOTE:  If you wish to allow the dragline to be positioned outside
  805. ;;;      of the two arcs or lines being created, you may set the local 
  806. ;;;      variable "dragos" = T, on the 4th line of the defun, which  
  807. ;;;      checks that the offset value entered is not greater or less 
  808. ;;;      than + or - TRACEWID / 2.
  809. ;;;      
  810. ;;;      You should be aware that the results of allowing this to occur
  811. ;;;      may not be obvious or necessarily correct.  Specifically, when
  812. ;;;      drawing lines with a width of 1 and an offset of 4, if you draw
  813. ;;;      segments as follows, the lines will cross back on themselves.
  814. ;;;      
  815. ;;;      dl 0,0,0 10,0,0 10,5 then 5,5
  816. ;;;      
  817. ;;;      However, this can be quite useful for creating parallel DLINE's.
  818. ;;;      
  819. ;;; dl_sao == DLine_Set_Alignment_Option
  820. ;;;
  821. (defun dl_sao (/ temp dragos)
  822.   (initget "Left Center Right")
  823.   (setq temp dl:osd)
  824.   ;;(setq dragos T)                   ; See note above.
  825.   (setq dl:osd (getreal (strcat
  826.     "\nSet dragline position to Left/Center/Right/<Offset from center = "
  827.     (rtos dl:osd) ">: ")))
  828.   (cond
  829.     ((= dl:osd "Left")
  830.       (setq dl:aln 1
  831.             dl:osd (- (/ (getvar "tracewid") 2.0))
  832.       )
  833.     )
  834.     ((= dl:osd "Center")
  835.       (setq dl:aln 0
  836.             dl:osd 0.0
  837.       )
  838.     )
  839.     ((= dl:osd "Right")
  840.       (setq dl:aln 2
  841.             dl:osd (/ (getvar "tracewid") 2.0)
  842.       )
  843.     )
  844.     ((= (type dl:osd) 'REAL)
  845.       (if dragos
  846.         (setq dl:aln nil)
  847.         (progn
  848.           (setq dl:aln nil)
  849.           (if (> dl:osd (/ (getvar "tracewid") 2.0))
  850.             (progn
  851.               (princ "\nValue entered is out of range.  Reset to ")
  852.               (princ (/ (getvar "tracewid") 2.0))
  853.               (setq dl:osd (/ (getvar "tracewid") 2.0))
  854.             )
  855.           )
  856.           (if (< dl:osd (- (/ (getvar "tracewid") 2.0)))
  857.             (progn
  858.               (princ "\nValue entered is out of range.  Reset to ")
  859.               (princ (- (/ (getvar "tracewid") 2.0)))
  860.               (setq dl:osd (- (/ (getvar "tracewid") 2.0)))
  861.             )
  862.           )
  863.         )
  864.       )
  865.     )
  866.     (T
  867.       (setq dl:osd temp)
  868.     )
  869.   )
  870. )
  871. ;;;
  872. ;;; Set a new DLINE width.
  873. ;;;
  874. ;;; dl_snw == DLine_Set_New_Width
  875. ;;;
  876. (defun dl_snw ()
  877.   (initget 6)
  878.   (setvar "tracewid"
  879.     (if (setq temp (getdist (strcat 
  880.       "\nNew DLINE width <" (rtos (getvar "tracewid")) ">: ")))
  881.       temp
  882.       (getvar "tracewid") 
  883.     ) 
  884.   )
  885.   (if dl:aln
  886.     (cond
  887.       ((= dl:aln 1) ; left aligned
  888.         (setq dl:osd (- (/ (getvar "tracewid") 2.0)))
  889.       )
  890.       ((= dl:aln 2) ; right aligned
  891.         (setq dl:osd (/ (getvar "tracewid") 2.0))
  892.       )
  893.       (T
  894.         (princ)     ; center aligned
  895.       )
  896.     )
  897.   )
  898. )
  899. ;;;
  900. ;;; Get an offset from a given point to the start point toward a second
  901. ;;; point.  The distance between the two points is the default, but any
  902. ;;; positive distance may be entered.  If a negative number is entered,
  903. ;;; it is used as a percentage distance from the "Offset from" point 
  904. ;;; toward the "Offset toward" point, i.e., if -75 is entered, a point
  905. ;;; 75% of the distance between the two points listed above is returned.
  906. ;;; 
  907. ;;;
  908. ;;; dl_ofs == DLine_OFfset_Startpoint
  909. ;;;
  910. (defun dl_ofs ()
  911.   (menucmd "s=osnapb")
  912.   (initget 1)
  913.   (setq strtpt (getpoint "\nOffset from: "))
  914.   (initget 1)
  915.   (setq nextpt (getpoint strtpt "\nOffset toward: "))
  916.   
  917.   (setq dist (getdist strtpt (strcat
  918.     "\nEnter the offset distance <" (rtos (distance strtpt nextpt)) 
  919.     ">: ")))
  920.   (setq dist (if (or (= dist "") (null dist))
  921.                (distance strtpt nextpt)
  922.                (if (< dist 0)
  923.                  (* (distance strtpt nextpt) (/ (abs dist) 100.0))
  924.                  dist
  925.                )
  926.              )
  927.   )              
  928.   (setq strtpt (polar strtpt
  929.                       (angle strtpt nextpt)
  930.                       dist
  931.                ) 
  932.   )
  933.   (setq temp nil)
  934.   (command "_.UNDO" "_GROUP")
  935. )
  936. ;;;
  937. ;;; Set snap options to ON, OFF or set the size of the area to be searched
  938. ;;; by (ssget point) via "pickbox".  This value is being limited for built-
  939. ;;; in display drivers at 10 pixels.  For ADI drivers it may be necessary 
  940. ;;; to bump up this number by adjusting "MAXSNP" at the top of this file.
  941. ;;;
  942. ;;; dl_sso == DLine_Set_Snap_Options
  943. ;;;
  944. (defun dl_sso ()
  945.   (initget "ON OFf Size")
  946.   (setq ans (getkword
  947.     "\nSet snap size or snap On/Off.  Size/OFF/<ON>: "))
  948.   (if (= ans "OFf") 
  949.     (progn
  950.       (setq dl:snp nil)
  951.       (setvar "pickbox" 0) 
  952.     )
  953.     (if (= ans "Size") 
  954.       (progn
  955.         (setq dl:snp T ans 0)
  956.         (while (or (< ans 1) (> ans MAXSNP))
  957.           (setq ans (getint (strcat
  958.             "\nNew snap size (1 - " (itoa MAXSNP) ") <" (itoa dl:opb) ">: ")))
  959.  
  960.           (if (or (= ans "") (null ans))
  961.             (setq ans dl:opb)
  962.           )
  963.         )
  964.         (setvar "pickbox" ans)
  965.         (setq dl:opb ans)
  966.       )
  967.       (progn
  968.         (setq dl:snp T)
  969.         (setvar "pickbox" dl:opb)
  970.       )  
  971.     ) 
  972.   )
  973.   (if dl:snp
  974.     (if (= uctr 0)
  975.       (dl_ved "brk_e1" strtpt)
  976.     ) 
  977.   ) 
  978.   (if dl_arc
  979.     (setq nextpt "Arc")
  980.     (setq nextpt "Line")
  981.   )
  982.  
  983. )
  984. ;;;
  985. ;;; Obtain and verify the extrusion direction of an entity at the 
  986. ;;; start point or endpoint of the line or arc we are drawing.
  987. ;;;
  988. ;;; dl_ved == DLine_Verify_Extrusion_Direction
  989. ;;;
  990. (defun dl_ved (vent pt)
  991.   ;; Get entity to break if the user snapped to a DLINE.
  992.   ;; Make sure that it is a line or arc and that its extrusion
  993.   ;; direction is parallel to the current UCS.
  994.   (if (set (read vent) (ssget pt))
  995.     (progn
  996.       (set (read vent) (ssname (eval (read vent)) 0))
  997.       (if (and 
  998.             (or (= (dl_val 0 (eval (read vent))) "ARC")
  999.                 (= (dl_val 0 (eval (read vent))) "LINE")
  1000.             )
  1001.             (equal (caddr(dl_val 210 (eval (read vent))))
  1002.                    (caddr(trans '(0 0 1) 1 0)) 0.001)
  1003.           )
  1004.         (princ)
  1005.         (progn
  1006.           (princ (strcat
  1007.             "\nEntity found is not an arc or line, "
  1008.             "or is not parallel to the current UCS. "))
  1009.           (set (read vent) nil)
  1010.         )
  1011.       )
  1012.     )
  1013.   )
  1014.   (eval (read vent))
  1015. )
  1016. ;;;
  1017. ;;; Verify nextpt.
  1018. ;;; Get the point on the arc at the opposite 
  1019. ;;; end from the start point (strtpt).
  1020. ;;;
  1021. ;;; dl_vnp == DLine_Verify_NextPt
  1022. ;;;
  1023. (defun dl_vnp (/ temp cpt ang rad)
  1024.  
  1025.   (setq temp (entlast))
  1026.   (if (= (dl_val 0 temp) "LINE")
  1027.     (setq nextpt (if (equal strtpt (dl_val 10 temp) 0.001)
  1028.                    (dl_val 11 temp)
  1029.                    (dl_val 10 temp)
  1030.                  )
  1031.     )
  1032.     ;; Then it must be an arc...
  1033.     (progn
  1034.       ;; get its center point
  1035.       (setq cpt  (trans (dl_val 10 temp) (dl_val -1 temp) 1)
  1036.             ang  (dl_val 50 temp)     ; starting angle
  1037.             rad  (dl_val 40 temp)     ; radius
  1038.       )
  1039.       (setq ange (trans '(1 0 0) (dl_val -1 temp) 1)
  1040.             ange (angle '(0 0 0) ange)
  1041.             ang (+ ang ange)
  1042.       )
  1043.       (if (> ang (* 2 pi))
  1044.         (setq ang (- ang (* 2 pi)))
  1045.       )
  1046.       (setq nextpt (if (equal strtpt (polar cpt ang rad) 0.01)
  1047.                      (polar cpt (dl_val 51 temp) rad)
  1048.                      (polar cpt ang rad)
  1049.                    )
  1050.       )
  1051.     )
  1052.   )
  1053. )
  1054. ;;; ----------------- Main Line Drawing Function -------------------
  1055. ;;;
  1056. ;;; Draw the lines.
  1057. ;;;
  1058. ;;; dl_mlf == DLine_Main_Line_Function
  1059. ;;;
  1060. (defun dl_mlf (flg / temp1 temp2 newang ang1 ang2 
  1061.                      ent cpt ang rad1 rad2 sent1 sent2
  1062.                      tmpt1 tmpt2 tmpt3 tmpt4)
  1063.  
  1064.   ;; Verify nextpt
  1065.   (if (null nextpt) (setq nextpt (dl_vnp)))
  1066.   
  1067.   (if (equal nextpt (nth 0 spts) 0.01)
  1068.     (if dl_arc
  1069.       (setq flg 4)
  1070.       (setq flg 3)
  1071.     )
  1072.   )
  1073.    
  1074.   (setq temp1  (+ (/ (getvar "tracewid") 2.0) dl:osd)
  1075.         temp2  (- (getvar "tracewid") temp1)
  1076.         newang (angle strtpt nextpt)
  1077.         ang1   (+ (angle strtpt nextpt) (/ pi 2))
  1078.         ang2   (- (angle strtpt nextpt) (/ pi 2))
  1079.   )
  1080.   (cond
  1081.     ((= flg 1)                        ; if drawing lines
  1082.       (dl_dls nil ang1 temp1)         ; Draw line segment 1
  1083.       (dl_dls nil ang2 temp2)         ; Draw line segment 2
  1084.     )
  1085.     ((or (= flg 2) (= flg 4))         ; else drawing arcs...
  1086.       (setq tmp (entlast)             ; get the last arc entity
  1087.             ent  (entget tmp)         ; (i.e., the guideline)
  1088.             ;; get its center point
  1089.             cpt  (trans (dl_val 10 tmp) (dl_val -1 tmp) 1) 
  1090.             ang  (dl_val 50 tmp)      ; starting angle
  1091.       )
  1092.       (setq ange (trans '(1 0 0) (dl_val -1 tmp) 1)
  1093.             ange (angle '(0 0 0) ange)
  1094.             ang (+ ang ange)
  1095.       )
  1096.       (if (> ang (* 2 pi))
  1097.         (setq ang (- ang (* 2 pi)))
  1098.       )
  1099.      
  1100.       ;; if start angle needs revision
  1101.       (if (equal (angle cpt strtpt) ang 0.01)   
  1102.         (progn
  1103.           ;; Start angle needs revision.
  1104.           (setq strt_a T
  1105.                 rad1  (+ (dl_val 40 tmp) temp2) ; outer radius
  1106.                 rad2  (- (dl_val 40 tmp) temp1) ; inner radius
  1107.           )
  1108.           (setq ent (subst (cons 40 rad2) ; modify its radius
  1109.                            (assoc 40 ent) 
  1110.                            ent))
  1111.           (entmod ent) 
  1112.           (dl_atl)                    ; Add ename to list
  1113.           (setq save_1 ent)
  1114.           (setq sent1 (dl_val -1 tmp))                            
  1115.           (if (= flg 4)
  1116.             (if (> uctr 2)
  1117.               (dl_das 0 rad2 50)      ; modify arc endpt and close
  1118.             )
  1119.             (dl_das nil rad2 50)      ; else modify arc endpt
  1120.           )
  1121.           ;; Create the "parallel" arc
  1122.           (command "_.OFFSET" (getvar "tracewid") ; offset the arc
  1123.                               (list tmp '(0 0 0)) 
  1124.                               (polar cpt ang (+ 1 rad1 rad2))
  1125.                               "")
  1126.           (setq tmp (entlast)         ; get the offset arc
  1127.                 ent  (entget tmp))
  1128.           (dl_atl)                    ; Add ename to list
  1129.           (setq save_2 ent)
  1130.           (setq sent2 tmp) 
  1131.           (if (= flg 4)
  1132.             (if (> uctr 3)
  1133.               (progn
  1134.                 (dl_das 1 rad1 50)    ; modify arc endpt and close
  1135.  
  1136.                 ;; set nextpt to "CLose" which will cause an exit.
  1137.                 (setq nextpt "CLose"
  1138.                       v:stpt nil
  1139.                       cont   nil
  1140.                 )
  1141.               )
  1142.             )
  1143.             (dl_das nil rad1 50)      ; else modify arc endpt
  1144.           )
  1145.  
  1146.         )
  1147.         (progn                        ; if end angle needs revision
  1148.           ;; End angle needs revision.
  1149.           (setq strt_a nil
  1150.                 rad1  (+ (dl_val 40 tmp) temp1) ; outer radius
  1151.                 rad2  (- (dl_val 40 tmp) temp2) ; inner radius
  1152.           )
  1153.           (setq ent (subst (cons 40 rad1) ; modify its radius
  1154.                            (assoc 40 ent) 
  1155.                            ent))
  1156.           (entmod ent)                             
  1157.           (dl_atl)                    ; Add ename to list
  1158.           (setq save_1 ent)
  1159.           (setq sent1 (dl_val -1 tmp))                            
  1160.           (if (= flg 4)
  1161.             (if (> uctr 2)
  1162.               (dl_das 0 rad1 51)      ; modify arc endpt and close
  1163.             )
  1164.             (dl_das nil rad1 51)      ; else modify arc endpt
  1165.           )
  1166.           ;; Create the "parallel" arc
  1167.           (command "_.OFFSET" (getvar "tracewid")    
  1168.                             (list tmp '(0 0 0)) 
  1169.                             cpt 
  1170.                             "")
  1171.           (setq tmp (entlast)         ; get the last arc entity
  1172.                 ent  (entget tmp))
  1173.           (dl_atl)                    ; Add ename to list
  1174.           (setq save_2 ent)
  1175.           (setq sent2 tmp)
  1176.           (if (= flg 4)
  1177.             (if (> uctr 3)
  1178.               (progn
  1179.                 (dl_das 1 rad2 51)    ; modify arc endpt and close
  1180.  
  1181.                 ;; set nextpt to "CLose" which will cause an exit.
  1182.                 (setq nextpt "CLose"
  1183.                       v:stpt nil
  1184.                       cont   nil
  1185.                 )
  1186.               )
  1187.             )
  1188.             (dl_das nil rad2 51)      ; else modify arc endpt
  1189.           )
  1190.         )
  1191.       )
  1192.  
  1193.     )
  1194.     ((= flg 3)                        ; if straight closing
  1195.       (setq nextpt (nth 0 spts)
  1196.             ang1   (+ (angle strtpt nextpt) (/ pi 2))
  1197.             ang2   (- (angle strtpt nextpt) (/ pi 2))
  1198.       )
  1199.       (dl_dls 0 ang1 temp1)
  1200.       (dl_dls 1 ang2 temp2)
  1201.  
  1202.       ;; set nextpt to "CLose" which will cause an exit.
  1203.       (setq nextpt "CLose"
  1204.             v:stpt nil
  1205.             cont   nil
  1206.       )
  1207.     )
  1208.     (T
  1209.       (princ "\nERROR:  Value out of range. ")
  1210.       (exit)
  1211.     )
  1212.   )
  1213.   (setq strtpt nextpt   
  1214.         spts   (append spts (list strtpt))
  1215.         savpts (append savpts (list savpt3))
  1216.         savpts (append savpts (list savpt4))
  1217.   )
  1218.   (command "_.UNDO" "_E")                ; only end when DLINE's have been drawn
  1219. )
  1220. ;;; ------------------- End Support Functions -----------------------
  1221. ;;; ---------------- Begin Line Drawing Functions -------------------
  1222. ;;;
  1223. ;;; Straight DLINE function
  1224. ;;;
  1225. ;;; dl_dls == DLine_Draw_Line_Segment
  1226. ;;;
  1227. (defun dl_dls (flgn ang temp / j k pt1 pt2 tmp1 ent1 p1 p2)
  1228.  
  1229.   (mapcar                             ; get endpoints of the offset line
  1230.     '(lambda (j k)
  1231.        (set j (polar (eval k) ang temp))
  1232.      )      
  1233.      '(pt1 pt2)
  1234.      '(strtpt nextpt)
  1235.   )
  1236.   (cond
  1237.     ((= uctr 0)
  1238.       ;; Set points 1 and 2 for segment 1.
  1239.       (setq p1 (if (dl_l01 brk_e1 "1" pt1 pt2 strtpt) ipt savpt1)) 
  1240.       (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 nextpt) ipt savpt3))
  1241.       (setq pt1 p1)
  1242.     )
  1243.     ((= uctr 1)
  1244.       ;; Set points 1 and 2 for segment 2.
  1245.       (setq p1 (if (dl_l01 brk_e1 "2" pt1 pt2 strtpt) ipt savpt2))
  1246.       (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt) ipt savpt4))
  1247.       (setq pt1 p1)
  1248.       
  1249.       ;; Now break the line or arc found at the start point 
  1250.       ;; if there is one, and we are in a breaking mood.
  1251.       (if (and dl:brk brk_e1)
  1252.         (progn
  1253.           (command "_.BREAK" brk_e1 savpt1 savpt2)
  1254.         )
  1255.       )
  1256.       ;; Now break the line or arc found at the end point 
  1257.       ;; if there is one, and we are in a breaking mood.
  1258.       (if (and dl:brk brk_e2)
  1259.         (progn
  1260.           (if (eq brk_e1 brk_e2)
  1261.             (progn
  1262.               ;; Delete first line so we can find the arc or line that
  1263.               ;; we found previously.
  1264.               (entdel (nth 0 wnames))  
  1265.               (dl_ved "brk_e2" nextpt)
  1266.               ;; Restore first line
  1267.               (entdel (nth 0 wnames))
  1268.             )
  1269.           )
  1270.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1271.         )
  1272.       )
  1273.       ;; Do not set brk_e2 nil... it will be set later.
  1274.     )
  1275.     ((= (rem uctr 2.0) 0)    
  1276.       (setq fang nil)
  1277.       (setq p1 (dl_dl2 pt1))          ; Draw line part 2
  1278.       (setq pt2 (if (dl_l01 brk_e2 "3" pt2 pt1 strtpt) 
  1279.                   ipt
  1280.                   savpt3
  1281.                 )
  1282.       )
  1283.       (setq pt1 p1)
  1284.       (if flgn                        ; if closing
  1285.         (progn
  1286.           (setq tmp1 (nth flgn wnames)
  1287.                 ent1 (entget tmp1)    ; get the corresponding prev. entity
  1288.           )
  1289.           (if (= (dl_val 0 tmp1) "LINE")
  1290.             ;; if it's a line
  1291.             (setq pt2 (dl_mls nil 10))           
  1292.             ;; if it's an arc
  1293.             (setq pt2 (dl_mas T nil pt2 pt1 nil))  
  1294.           )
  1295.         )                             
  1296.       )
  1297.     )
  1298.     (T
  1299.       (setq p1 (dl_dl2 pt1))              ; Draw line part 2
  1300.       (setq pt2 (if (dl_l01 brk_e2 "4" pt2 pt1 nextpt) 
  1301.                   ipt
  1302.                   savpt4
  1303.                 )
  1304.       )
  1305.       (setq pt1 p1)
  1306.       (if flgn                        ; if closing
  1307.         (progn
  1308.           (setq tmp1 (nth flgn wnames)
  1309.                 ent1 (entget tmp1)    ; get the corresponding prev. entity
  1310.                 brk_e1 nil
  1311.                 brk_e2 nil
  1312.           )
  1313.           (if (= (dl_val 0 tmp1) "LINE")
  1314.             ;; if it's a line
  1315.             (setq pt2 (dl_mls nil 10))           
  1316.             ;; if it's an arc
  1317.             (setq pt2 (dl_mas T nil pt2 pt1 nil))  
  1318.           )
  1319.         )                             
  1320.       )
  1321.       ;; Now break the line or arc found at the end point 
  1322.       ;; if there is one, and we are in a breaking mood.
  1323.       (if (and dl:brk brk_e2)
  1324.         (progn
  1325.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1326.         )
  1327.       )
  1328.       ;; Do not set brk_e2 nil... it will be set later.
  1329.     )
  1330.   )
  1331.   (command "_.LINE" pt1 pt2 "")         ; draw the line
  1332.   (setq wnames (if (null wnames) 
  1333.                  (list (setq elast (entlast)) )
  1334.                  (append wnames (list (setq elast (entlast)))))
  1335.         uctr   (1+ uctr)
  1336.   )
  1337.   wnames
  1338. )
  1339. ;;;
  1340. ;;; Set pt1 or pt2 based on whether there is an arc or line to be broken.
  1341. ;;;
  1342. ;;; dl_l01 == DLine_draw_Lines_0_and_1
  1343. ;;;
  1344. (defun dl_l01 (bent1 n p1 p2 pt / temp)
  1345.   (setq n (strcat "savpt" n))
  1346.   (setq spt nil)
  1347.   (if bent1
  1348.     (if (= (dl_val 0 bent1) "LINE")
  1349.       (progn
  1350.         (setq temp (inters (trans (dl_val 10 bent1) 0 1)
  1351.                             (trans (dl_val 11 bent1) 0 1)
  1352.                             p1
  1353.                             p2
  1354.                             nil
  1355.                     )
  1356.         ) 
  1357.         (if temp
  1358.           (set (read n) temp)
  1359.           (progn
  1360.             (set (read n) p1)
  1361.             (setq brk_e1 nil)
  1362.           )
  1363.         )
  1364.       )
  1365.       (progn
  1366.         (set (read n) (dl_ial bent1 p1 p2 pt))
  1367.         ;; Spt is set only if there was no intersection point.
  1368.         (if spt
  1369.           (progn
  1370.             (setq ipt (eval (read n)))
  1371.             (set (read n) spt)
  1372.           )
  1373.         )
  1374.       )
  1375.     )
  1376.     (set (read n) p1)
  1377.   )
  1378.   (if spt
  1379.     T
  1380.     nil
  1381.   )
  1382. )
  1383. ;;;
  1384. ;;; Do more of the line drawing stuff.  This is where we call the modify 
  1385. ;;; functions for the previous arc or line segment.  The line end being
  1386. ;;; modified is always the group 11 end, but we have to test the start
  1387. ;;; and end angle of an arc to tell which end to modify.
  1388. ;;;
  1389. ;;; dl_dl2 == DLine_Draw_Line_segment_part_2
  1390. ;;;
  1391. (defun dl_dl2 (npt)
  1392.   (setq tmp1 (nth (- uctr 2) wnames)
  1393.         ent1 (entget tmp1))           ; get the corresponding prev. entity
  1394.    
  1395.   (if (= (dl_val 0 tmp1) "LINE")  
  1396.     ;; Check angles 0 180, -180  and 360...   
  1397.     (if (or  (equal (angle strtpt nextpt)
  1398.                    (angle (trans (dl_val 10 tmp1) 0 1)
  1399.                           (trans (dl_val 11 tmp1) 0 1)) 0.001)
  1400.              (equal (angle strtpt nextpt)
  1401.                    (angle (trans (dl_val 11 tmp1) 0 1)
  1402.                           (trans (dl_val 10 tmp1) 0 1)) 0.001)
  1403.              (equal (+ (* 2 pi) (angle strtpt nextpt))
  1404.                    (angle (trans (dl_val 10 tmp1) 0 1)
  1405.                           (trans (dl_val 11 tmp1) 0 1)) 0.001)
  1406.         )
  1407.       ;; if it's a line
  1408.       (progn
  1409.         (setq brk_e2 nil)
  1410.         (command "_.LINE" (trans (dl_val 11 tmp1) 0 1) pt1 "") 
  1411.         pt1 
  1412.       )
  1413.       ;; else, if it's an arc
  1414.       (progn
  1415.         (dl_mls nil 11)
  1416.       )
  1417.     )
  1418.     ;; if it's an arc
  1419.     (dl_mas nil nil pt1 pt2 strtpt)  
  1420.   )
  1421. )
  1422. ;;;
  1423. ;;; Modify line endpoint
  1424. ;;;
  1425. ;;; dl_mls == DLine_Modify_Line_Segment
  1426. ;;;
  1427. (defun dl_mls (flg2 nn / spt ept pt)  ; flg2 = nil if line to line
  1428.                                       ;      = T   if line to arc
  1429.  
  1430.   ;; This is the previous entity; a line
  1431.   (setq spt (trans (dl_val 10 tmp1) 0 1)   
  1432.         ept (trans (dl_val 11 tmp1) 0 1)
  1433.   )
  1434.   (if flg2
  1435.     ;; find intersection with arc; tmp == ename of arc
  1436.     (progn
  1437.       ;; Find arc intersection with line; tmp == ename of arc.
  1438.       (setq pt (dl_ial tmp spt ept (if flgn nextpt strtpt)))
  1439.     )
  1440.  
  1441.     ;; find intersection with line
  1442.     (setq pt (inters spt ept pt1 pt2 nil)) 
  1443.   )
  1444.   ;; modify the previous line
  1445.   (if pt 
  1446.     (entmod (subst (cons nn (trans pt 1 0)) 
  1447.                    (assoc nn ent1) 
  1448.                    ent1))
  1449.     (setq pt pt2)
  1450.   )
  1451.   pt
  1452. )
  1453. ;;; 
  1454. ;;; This routine does a variety of tasks: it calculate the distance from
  1455. ;;; the center of the arc (or congruent circle) to a line, then it
  1456. ;;; calculates up to two intersection points of a line and the arc,
  1457. ;;; then it attempts to determine which of the points serves as a 
  1458. ;;; best-fit to the following criteria:
  1459. ;;; 
  1460. ;;;   1) One end of the arc must lie "on" the line, or
  1461. ;;;      one end of the line must lie on the arc. 
  1462. ;;;   2) Given that the point given in 1 above is p1,
  1463. ;;;      and that the other point is p2, then if the arc crosses over
  1464. ;;;      the line then use p2, otherwise the arc does not cross over
  1465. ;;;      the line so use p1.
  1466. ;;;      
  1467. ;;; If the line and the arc do not intersect, then a line will be drawn
  1468. ;;; from the point of intersection of the arc and the perpendicular from
  1469. ;;; the line to the arc centerpoint, and the line;  The line and arc will be 
  1470. ;;; trimmed or extended as needed to meet these points.
  1471. ;;; 
  1472. ;;; If the line and arc are tangent, then the arc and line are
  1473. ;;; trimmed/extended to this point. 
  1474. ;;;
  1475. ;;; p1 and p2 are two points on a line
  1476. ;;; ename  == entity name of arc
  1477. ;;; flg == T when the segment being drawn ends on an arc, 
  1478. ;;; flg == nil when the segment being drawn starts on an arc.
  1479. ;;;
  1480. ;;; dl_ial == DLine_Intersect_Arc_with_Line
  1481. ;;;
  1482. (defun dl_ial (arc pt_1 pt_2 npt / d pi2 rad ang nang temp ipt)
  1483.  
  1484.   (setq cpt  (trans (dl_val 10 arc) (dl_val -1 arc) 1)  
  1485.         pi2  (/ pi 2)                 ; 1/2 pi
  1486.         ang  (angle pt_1 pt_2)                   
  1487.         nang (+ ang pi2)              ; Normal to "ang"
  1488.         temp (inters pt_1 pt_2 cpt (polar cpt nang 1) nil)
  1489.         nang (angle cpt temp)
  1490.   )
  1491.   ;; Get the perpendicular distance from the center of the arc to the line.
  1492.   (setq d (distance cpt temp))
  1493.  
  1494.   (cond
  1495.     ((equal (setq rad (dl_val 40 arc)) d 0.01)
  1496.       ;; One intersection.
  1497.       (setq ipt temp)
  1498.     )
  1499.     ((< rad d)                       
  1500.       ;; No intersection.
  1501.       (setq spt (polar cpt nang rad)
  1502.             ipt temp
  1503.       )
  1504.       (command "_.LINE" spt ipt "")
  1505.       ipt
  1506.     )
  1507.     (T
  1508.       ;; Two intersections. Now...
  1509.       ;; If drawing arcs, fang is set, we're past the first segment...
  1510.       ;; Reset the `near' point based on the previous ipt.  This can be
  1511.       ;; quite different and necessary from the `npt' passed in.
  1512.       (if (and dl_arc fang (> uctr 1)) 
  1513.         (setq npt (polar cpt fang rad))
  1514.       )
  1515.       (dl_g2p npt)
  1516.       (setq ipt (dl_bp arc pt_1 pt_2 ipt1 ipt2))
  1517.       ;; If `fang' is not set, set it, otherwise set it to nil.
  1518.       (if fang 
  1519.         (setq fang nil)
  1520.         (if dl_arc (setq fang (angle cpt ipt)))
  1521.       )
  1522.       ipt
  1523.     )
  1524.   )
  1525. )
  1526. ;;;
  1527. ;;; Get two intersection points, ordering them such that ipt1
  1528. ;;; is the closer of the two points to the passed-in point "npt".
  1529. ;;;
  1530. ;;; dl_g2p == DLine_Get_2_Points
  1531. ;;;
  1532. (defun dl_g2p (npt / temp l theta)
  1533.   (if (equal d 0.0 0.01)
  1534.     (setq theta pi2
  1535.           nang (+ ang pi2)            ; Normal to "ang"
  1536.     )
  1537.     (setq l     (sqrt (abs (- (expt rad 2) (expt d 2))))
  1538.           theta (abs (atan (/ l d)))
  1539.     )
  1540.   )
  1541.   ;; Get the two angles to the infinite intersection points of the 
  1542.   ;; congruent circle to the arc, and the line, then get the two 
  1543.   ;; intersection points.
  1544.   (setq ipt1 (polar cpt (- nang theta) rad))
  1545.   (setq ipt2 (polar cpt (+ nang theta) rad))
  1546.   ;; Set the closer of the two points to npt to be ipt1.
  1547.   (if (< (distance ipt2 npt) (distance ipt1 npt))
  1548.     ;; Swap points
  1549.     (setq temp ipt1
  1550.           ipt1 ipt2
  1551.           ipt2 temp
  1552.     )
  1553.     (if (equal (distance ipt2 npt) (distance ipt1 npt) 0.01)
  1554.       (exit)
  1555.     )
  1556.   )
  1557.   ipt1
  1558. )
  1559. ;;;
  1560. ;;; Test a point `pt' to see if it is on the line `sp--ep'.
  1561. ;;;
  1562. ;;; dl_onl == DLine_ON_Line_segment
  1563. ;;;
  1564. (defun dl_onl (sp ep pt / cpt sa ea ang)
  1565.   (if (inters sp ep pt
  1566.               (polar pt (+ (angle sp ep) (/ pi 2))
  1567.                      (/ (getvar "tracewid") 10)
  1568.               )
  1569.               T)
  1570.     T 
  1571.     nil
  1572.   )
  1573. )
  1574. ;;;
  1575. ;;; Test a point `pt' to see if it is on the arc `arc'.
  1576. ;;;
  1577. ;;; dl_ona == DLine_ON_Arc_segment
  1578. ;;;
  1579. (defun dl_ona (arc pt / cpt sa ea ang)
  1580.   (setq cpt (trans (dl_val 10 arc) (dl_val -1 arc) 1) 
  1581.         sa  (dl_val 50 arc)           ; angle of current ent start point
  1582.         ea  (dl_val 51 arc)           ; angle of current ent end point
  1583.         ang (angle cpt pt)            ; angle to pt.
  1584.   )
  1585.   (if (> sa ea)
  1586.     (if (or (and (> ang sa) (< ang (+ ea (* 2 pi))))
  1587.             (and (> ang (- ea (* 2 pi))) (< ang ea))
  1588.         ) 
  1589.       T 
  1590.       nil
  1591.     )
  1592.     (if (and (> ang sa) (< ang ea)) T nil)
  1593.   )
  1594. )
  1595. ;;;
  1596. ;;; Get the best intersection point of an arc and a line.  The criteria
  1597. ;;; are as follows:
  1598. ;;; 
  1599. ;;;   1) The best point will lie on both the arc and the line.
  1600. ;;;   2) It will be the point which causes the shortest arc to be created
  1601. ;;;      such that (1) is satisfied.
  1602. ;;;   3) If closing, then always use the point closest to nextpt.  Unless,
  1603. ;;;      the points are equidistant, then use 1 and 2 above to tiebreak.
  1604. ;;;   4) If breaking an arc with a line, always use the points nearest the
  1605. ;;;      break point.
  1606. ;;;
  1607. ;;; dl_bp == DLine_Best_Point_of_arc_and_line
  1608. ;;;
  1609. (defun dl_bp (en1 p1 p2 pp1 pp2 / temp temp1 temp2)
  1610.   (setq temp1 (dl_onl p1 p2 pp2)
  1611.         temp2 (dl_ona en1 pp2)
  1612.         temp  (if (or (= flg 1) (= flg 3)) T nil)
  1613.   )
  1614.   (if (and temp1 temp2)
  1615.     (if (and (< uctr 2) 
  1616.              (and brk_e1 brk_e2))
  1617.       pp1
  1618.       (if (and temp (not fang)) pp1 pp2)
  1619.     )
  1620.     pp1
  1621.   )
  1622. )
  1623. ;;; ----------------- End Line Drawing Functions --------------------
  1624. ;;; ---------------- Begin Arc  Drawing Functions -------------------
  1625. ;;;
  1626. ;;; Draw curved DLINE
  1627. ;;;
  1628. ;;; dl_das == DLine_Draw_Arc_Segment
  1629. ;;;
  1630. (defun dl_das (flgn orad nn / tmp1 ent1 pt ang )
  1631.   (cond
  1632.     ((= uctr 0)
  1633.       (setq sent1 tmp)
  1634.       (dl_a01 brk_e1 "1" strtpt nil)  ; DLine_draw_Arc_0_and_1
  1635.       (dl_a01 brk_e2 "3" nextpt T)    ; DLine_draw_Arc_0_and_1
  1636.     )
  1637.     ((= uctr 1)
  1638.       (setq sent1 tmp)
  1639.       (dl_a01 brk_e1 "2" strtpt nil)  ; DLine_draw_Arc_0_and_1
  1640.       (dl_a01 brk_e2 "4" nextpt T)    ; DLine_draw_Arc_0_and_1
  1641.       (dl_mae nil T)
  1642.       (dl_mae nil nil)
  1643.       ;; Now break the line or arc found at the start point
  1644.       ;; if there is one, and we are in a breaking mood.
  1645.       (if (and dl:brk brk_e1)
  1646.         (progn
  1647.           (dl_mae T T)
  1648.           (dl_mae T nil)
  1649.           (command "_.BREAK" brk_e1 savpt1 savpt2)
  1650.         )
  1651.       )
  1652.       ;; Do not set brk_e1 nil... it will be set later.
  1653.       ;; Now break the line or arc found at the end point 
  1654.       ;; if there is one, and we are in a breaking mood.
  1655.       (if (and dl:brk brk_e2)
  1656.         (progn
  1657.           (if (eq brk_e1 brk_e2)
  1658.             (progn
  1659.               ;; Delete both arcs so we can find the arc or line that
  1660.               ;; we found previously.
  1661.               (entdel (nth 0 wnames))  
  1662.               (entdel (nth 1 wnames))  
  1663.               (dl_ved "brk_e2" nextpt)
  1664.               ;; Restore first line
  1665.               (entdel (nth 0 wnames))
  1666.               (entdel (nth 1 wnames))
  1667.             )
  1668.           )
  1669.           (if (null brk_e1)
  1670.             (progn
  1671.               (dl_mae T T)
  1672.               (dl_mae T nil)
  1673.             )
  1674.           )
  1675.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1676.         )
  1677.       )
  1678.       ;; Do not set brk_e2 nil... it will be set later.
  1679.     )
  1680.     ((= (rem uctr 2.0) 0) 
  1681.       (setq fang nil)
  1682.       (dl_da2)                        ; Draw arc part 2
  1683.       (if fang 
  1684.         (setq ftmp fang
  1685.               fang nil
  1686.         )
  1687.       )
  1688.       (setq save_1 ent)
  1689.       (setq sent1 (cdr(assoc -1 ent)))
  1690.       (setq pt2 (dl_a01 brk_e2 "3" nextpt T)) ; DLine_draw_Arc_0_and_1
  1691.       (if ftmp 
  1692.         (setq fang ftmp
  1693.               ftmp nil
  1694.         )
  1695.       )
  1696.     )
  1697.     (T
  1698.       (dl_da2)                        ; Draw arc part 2
  1699.       (if fang 
  1700.         (setq ftmp fang
  1701.               fang nil
  1702.         )
  1703.       )
  1704.       (setq save_2 ent)
  1705.       (setq sent1 (cdr(assoc -1 ent)))
  1706.       (setq pt2 (dl_a01 brk_e2 "4" nextpt T)) ; DLine_draw_Arc_0_and_1
  1707.       (if ftmp 
  1708.         (setq fang fang
  1709.               ftmp nil
  1710.         )
  1711.       )
  1712.  
  1713.       ;; Now break the line or arc found at the end point 
  1714.       ;; if there is one, and we are in a breaking mood.
  1715.       (if (and dl:brk brk_e2)
  1716.         (progn
  1717.           (dl_mae T T)
  1718.           (dl_mae T nil)
  1719.           (command "_.BREAK" brk_e2 savpt3 savpt4)
  1720.         )
  1721.       )
  1722.       ;; Do not set brk_e2 nil... it will be set later.
  1723.     )
  1724.   )
  1725.   (setq uctr   (1+ uctr))
  1726. )
  1727. ;;;
  1728. ;;; Set pt1 or pt2 based on whether there is an arc or line to be broken.
  1729. ;;;
  1730. ;;; dl_a01 == DLine_draw_Arcs_0_and_1
  1731. ;;;
  1732. (defun dl_a01 (bent1 n pt flg / pt1 pt2 ang1 ang2 anga angb)
  1733.   ;; "n" is the point to save for end capping
  1734.   (setq n (strcat "savpt" n))
  1735.   ;; "tmp" is the arc just created.
  1736.   ;; "bent1" is the line or arc to be broken, if there is one...
  1737.   (if bent1
  1738.     (if (= (dl_val 0 bent1) "LINE")
  1739.       (progn
  1740.         (set (read n) (dl_ial tmp (trans (dl_val 10 bent1) 0 1)
  1741.                                   (trans (dl_val 11 bent1) 0 1) pt)) 
  1742.       )
  1743.       (progn
  1744.         (setq curcpt (trans (dl_val 10 sent1) (dl_val -1 sent1) 1) 
  1745.               prvcpt (trans (dl_val 10 bent1) (dl_val -1 bent1) 1)
  1746.               pt1    (polar prvcpt (dl_val 50 bent1) (dl_val 40 bent1))
  1747.               pt2    (polar curcpt (dl_val nn sent1) (dl_val 40 sent1))
  1748.               ang1   (angle prvcpt pt1)
  1749.         )
  1750.         (if (not (equal ang1 (angle prvcpt strtpt) 0.01))
  1751.           (setq pt1  (polar prvcpt (dl_val 51 bent1) (dl_val 40 bent1))
  1752.                 ang1 (angle prvcpt pt1)
  1753.                 ang2 (angle curcpt pt2)
  1754.                 anga (- ang1 ang2)
  1755.                 angb (- ang2 ang1)
  1756.           )
  1757.         )
  1758.         (if (or (and (< anga 0.0872665)
  1759.                      (> anga -0.0872665))
  1760.                 (and (< angb 0.0872665)
  1761.                      (> angb -0.0872665))
  1762.             )
  1763.           (progn
  1764.             (set (read n) pt)
  1765.             (if (= bent1 brk_e1) 
  1766.               (setq brk_e1 nil)
  1767.               (setq brk_e2 nil)
  1768.             )
  1769.           )
  1770.           (set (read n) (dl_iaa sent1 bent1 pt flg))
  1771.         )
  1772.       )
  1773.     )
  1774.     (progn
  1775.       (setq cpt (trans (dl_val 10 tmp) (dl_val -1 tmp) 1))
  1776.       (set (read n) (polar cpt (angle cpt pt) orad))
  1777.     )
  1778.   )
  1779.   (eval (read n))
  1780. )
  1781. ;;;
  1782. ;;; Do more of the arc drawing stuff.  This is where we call the modify 
  1783. ;;; functions for the previous arc or line segment.  The line end being
  1784. ;;; modified is always the group 11 end, but we have to test the start
  1785. ;;; and end angle of an arc to tell which end to modify.
  1786. ;;;
  1787. ;;; dl_da2 == DLine_Draw_Arc_segment_part_2
  1788. ;;;
  1789. (defun dl_da2 (/ pt)
  1790.   ;; get the corresponding previous entity
  1791.   (setq tmp1 (nth (- uctr 2) wnames) 
  1792.         ent1 (entget tmp1))
  1793.   (if (= (dl_val 0 tmp1) "LINE")     
  1794.     ;; if it's a line
  1795.     (setq pt (dl_mls T 11))             
  1796.     ;; if it's an arc
  1797.     (setq pt (dl_mas nil T nil nil strtpt)) 
  1798.   )
  1799.   ;; pt is a point in the current UCS, not ECS
  1800.   (if pt
  1801.     (progn
  1802.       (setq ang (- (angle cpt pt) ange))
  1803.       (entmod (setq ent (subst (cons nn ang) 
  1804.                        (assoc nn ent) 
  1805.                        ent)))         ; modify arc endpt
  1806.     )
  1807.   )
  1808.   (if flgn                            ; if closing 
  1809.     (progn
  1810.       (setq tmp1 (nth flgn wnames)     
  1811.             ent1  (entget tmp1))  ; get the flagged entity
  1812.       (if (= (dl_val 0 tmp1) "LINE")     
  1813.         ;; if it's a line
  1814.         (setq pt (dl_mls T 10))   
  1815.         ;; if it's an arc
  1816.         (setq pt (dl_mas T T nil nil nextpt)) 
  1817.       )
  1818.       (if pt
  1819.         (progn
  1820.           (setq ang (- (angle cpt pt) ange))
  1821.           (setq nn (if (= nn 50) 51 50))
  1822.           (entmod (setq ent (subst (cons nn ang) 
  1823.                          (assoc nn ent) 
  1824.                          ent)))       ; modify arc endpt
  1825.         )                             
  1826.       )
  1827.     )                             
  1828.   )
  1829. )
  1830. ;;;
  1831. ;;; Modify the endpoints of an arc by changing the start and end angles.
  1832. ;;;
  1833. ;;; dl_mae == DLine_Modify_Arc_Endpoints
  1834. ;;;
  1835. (defun dl_mae (eflg sflg / nn1 nn2)
  1836.   (if (= nn 50)
  1837.     (setq nn1 50 nn2 51)
  1838.     (setq nn1 51 nn2 50)
  1839.   )
  1840.   (if sflg
  1841.     (if eflg
  1842.       (setq save_1 (subst (cons nn2 
  1843.                                 (angle 
  1844.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1845.                                   (trans savpt3 1 (cdr(assoc -1 save_1)))
  1846.                                 )
  1847.                           )
  1848.                           (assoc nn2 save_1) save_1)
  1849.       )
  1850.       (setq save_1 (subst (cons nn1 
  1851.                                 (angle 
  1852.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1853.                                   (trans savpt1 1 (cdr(assoc -1 save_1)))
  1854.                                 )
  1855.                           )
  1856.                           (assoc nn1 save_1) save_1)
  1857.       )
  1858.     )
  1859.     (if eflg
  1860.       (setq save_2 (subst (cons nn2 
  1861.                                 (angle 
  1862.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1863.                                   (trans savpt4 1 (cdr(assoc -1 save_2)))
  1864.                                 )
  1865.                           )
  1866.                           (assoc nn2 save_2) save_2)
  1867.       )
  1868.       (setq save_2 (subst (cons nn1 
  1869.                                 (angle 
  1870.                                   (trans cpt    1 (cdr(assoc -1 save_1)))
  1871.                                   (trans savpt2 1 (cdr(assoc -1 save_2)))
  1872.                                 )
  1873.                           )
  1874.                           (assoc nn1 save_2) save_2)
  1875.       )
  1876.     )
  1877.   )
  1878.   (if sflg
  1879.     (entmod save_1)
  1880.     (entmod save_2)
  1881.   )
  1882. )
  1883. ;;;
  1884. ;;; Modify arc                        ; flg2 = nil if arc to line
  1885. ;;;                                   ;      = T   if arc to arc
  1886. ;;;
  1887. ;;; dl_mas == DLine_Modify_Arc_Segment
  1888. ;;;
  1889. (defun dl_mas (flg3 flg2 spt ept pt / nnn pt1 pt2 rad1 ange)
  1890.   ;; get some stuff
  1891.   (setq cpt1   (trans (dl_val 10 tmp1) (dl_val -1 tmp1) 1)           
  1892.         rad1   (dl_val 40 tmp1)
  1893.         ang1   (dl_val 50 tmp1)
  1894.   )
  1895.   (if (null pt)                       ; if a point is not passed in:
  1896.     (setq pt (nth 0 spts))            ; set to initial saved start point.
  1897.   )               
  1898.   (setq ange (trans '(1 0 0) (dl_val -1 tmp1) 1)
  1899.         ange (angle '(0 0 0) ange)
  1900.         ang1 (+ ang1 ange)
  1901.   )
  1902.   (if (> ang1 (* 2 pi))
  1903.     (setq ang1 (- ang1 (* 2 pi)))
  1904.   )
  1905.   (if (equal (angle cpt1 pt) ang1 0.01) ; figure out if we're looking
  1906.     (setq nnn 50)                     ; for the start or end point of
  1907.     (setq nnn 51)                     ; the beginning arc, then
  1908.   )                                   ; get the intersection point
  1909.   ;; if arc to arc
  1910.   (if flg2
  1911.     ;; then
  1912.     (progn
  1913.       ;; find intersection with arc
  1914.       (setq pt1 (dl_iaa tmp tmp1 (if flg3 nextpt strtpt) flg2))   
  1915.       (if pt1 
  1916.         (progn
  1917.           (setq ang1 (- (angle cpt1 pt1) ange))
  1918.           (setq ent1 (subst (cons nnn ang1) 
  1919.                             (assoc nnn ent1) 
  1920.                             ent1))                 
  1921.           (entmod ent1)               ; modify arc endpt
  1922.         )
  1923.       )
  1924.     )
  1925.     ;; else
  1926.     (progn 
  1927.       ;; find arc intersection with line from spt to ept
  1928.       (setq pt1 (dl_ial tmp1 spt ept pt)) 
  1929.       (setq ang1 (- (angle cpt1 pt1) ange))
  1930.       (setq ent1 (subst (cons nnn ang1) 
  1931.                         (assoc nnn ent1) 
  1932.                         ent1))                 
  1933.       (entmod ent1)                   ; modify arc endpt
  1934.     )
  1935.   )
  1936.   pt1
  1937. )
  1938. ;;; ---------------- Begin Arc to Arc Functions ---------------------
  1939. ;;;
  1940. ;;; This routine does a variety of tasks: it calculate up to two 
  1941. ;;; intersection points of two arcs,
  1942. ;;; then it attempts to determine which of the points serves as a 
  1943. ;;; best-fit to the following criteria:
  1944. ;;; 
  1945. ;;;   1) One end of the arc must lie "on" the arc. 
  1946. ;;;   2) Given that the point given in 1 above is pt1,
  1947. ;;;      and that the other point is pt2, then if the arc crosses over
  1948. ;;;      the other arc then use pt2, otherwise the arc does not cross over
  1949. ;;;      the other arc so use pt1.
  1950. ;;;      
  1951. ;;; If the two arcs do not intersect, then a line will be drawn
  1952. ;;; from the point of intersection of the arc and the perpendicular from
  1953. ;;; the line of the two arc centerpoints;  The arcs will be 
  1954. ;;; trimmed or extended as needed to meet these points.
  1955. ;;; 
  1956. ;;; If the two arcs are tangent, then they are
  1957. ;;; trimmed/extended to this point. 
  1958. ;;;
  1959. ;;; Intersection point of two arcs or circles
  1960. ;;; a    = radius of ename 1
  1961. ;;; b    = distance from curcpt to prvcpt
  1962. ;;; c    = radius of ename 2
  1963. ;;; curcpt = center point of first circle or arc  -- bent1, bent2, tmp
  1964. ;;; prvcpt = center point of second circle or arc -- sent1, sent2, tmp1
  1965. ;;; npt  = near point for nearest test
  1966. ;;;
  1967. ;;; dl_iaa == DLine_Intersect_Arc_and_Arc
  1968. ;;;
  1969. (defun dl_iaa  (en1 en2 npt flga / a b c s ang alpha alph ipt 
  1970.                                    curcpt prvcpt temp temp1 temp2)
  1971.   (setq curcpt  (trans (dl_val 10 en1) (dl_val -1 en1) 1) ; the "last" entity
  1972.         prvcpt  (trans (dl_val 10 en2) (dl_val -1 en2) 1) ; the previous entity
  1973.         a       (dl_val 40 en2)
  1974.         b       (distance curcpt prvcpt)
  1975.         c       (dl_val 40 en1)
  1976.         s       (/ (+ a b c) 2.0)
  1977.         ang     (angle curcpt prvcpt)
  1978.   )
  1979.   (cond
  1980.     ;; circles are tangent
  1981.     ;; If (- s a) == 0, this would cause a divide by zero below...
  1982.     ((or (= (- s a) 0) (equal b (+ a c) 0.001) (equal b (abs (- a c)) 0.001))
  1983.       ;; Circles are tangent.
  1984.       (setq ipt nil)
  1985.     )
  1986.     ;; circles do not intersect
  1987.     ((and (or (> b (+ a c)) (if (> c a) (< (+ a b) c) (< (+ c b) a)))                 
  1988.           (not (equal (+ a b ) c (/ (+ a b c) 1000000))))
  1989.       ;; No intersection.
  1990.       (if (= flg 4) 
  1991.         (progn
  1992.           (setq ipt (polar curcpt (angle curcpt prvcpt) c))
  1993.           (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "")
  1994.         )
  1995.         (progn
  1996.           (setq ipt (polar curcpt (angle curcpt prvcpt) c))
  1997.           (command "_.LINE" (polar prvcpt (angle prvcpt ipt) a) ipt "")
  1998.         )
  1999.       )
  2000.     )
  2001.     (T
  2002.       ;; general law of cosines formula -- (- s a) != 0
  2003.       (setq alpha (* 2.0 (atan (sqrt (abs (/ (* (- s b) (- s c)) 
  2004.                                              (* s (- s a)))))))
  2005.       )
  2006.       
  2007.       (setq tpt1 (polar curcpt (+ ang alpha) c)
  2008.             tpt2 (polar curcpt (- ang alpha) c)
  2009.             anga  (angle curcpt npt)
  2010.             angb  (angle prvcpt npt)
  2011.       )
  2012.       ;; Two intersections. Now...
  2013.       ;; If drawing arcs, fang is set, we're past the first segment...
  2014.       ;; Reset the `near' point based on the previous ipt.  This can be
  2015.       ;; quite different and necessary from the `npt' passed in.
  2016.       (if (and dl_arc fang (> uctr 1)) 
  2017.         (setq npt (polar prvcpt fang c))
  2018.       )
  2019.       (if (< (distance tpt1 npt) (distance tpt2 npt))
  2020.         (setq temp tpt1
  2021.               tpt1 tpt2
  2022.               tpt2 temp
  2023.         )
  2024.       )
  2025.       (setq temp (angle prvcpt curcpt)) ; angle from prev ent to this ent
  2026.       (setq ipt (dl_bap en1 en2 tpt2 tpt1 nil))
  2027.       (if fang 
  2028.         (setq fang nil)
  2029.         (if dl_arc (setq fang (angle cpt ipt)))
  2030.       )
  2031.     )
  2032.   )
  2033.   (setq cpt curcpt)
  2034.   (setq cpt1 prvcpt)
  2035.   ipt                                 ; return point
  2036. )
  2037. ;;;
  2038. ;;; Get the best point for the arc/arc intersection.
  2039. ;;;
  2040. ;;; dl_bap == DLine_Best_Point_to_Arc
  2041. ;;;
  2042. (defun dl_bap (en1 en2 pp1 pp2 flg / temp1 temp2)
  2043.   (setq temp1 (dl_ona en1 pp2)
  2044.         temp2 (dl_ona en2 pp2)
  2045.   )
  2046.   (if temp2
  2047.     (if (and (< uctr 2) 
  2048.              (and brk_e1 brk_e2))
  2049.       pp1
  2050.       (if temp1 
  2051.         (if (< uctr 2) 
  2052.           pp2
  2053.           (if (not fang) pp2 pp1)
  2054.         )
  2055.         pp1
  2056.       )
  2057.     )
  2058.     pp1
  2059.   )        
  2060. )
  2061. ;;; ----------------- End Arc  Drawing Functions --------------------
  2062. ;;; -------------------- Begin Misc Functions -----------------------
  2063. ;;;
  2064. ;;; Add the entity name to the list in wnames.
  2065. ;;;
  2066. ;;; dl_atl == DLine_Add_To_List
  2067. ;;;
  2068. (defun dl_atl ()
  2069.   (setq wnames (if (null wnames) 
  2070.                  (list (entlast)) 
  2071.                  (append wnames (list tmp)))
  2072.   )
  2073.   wnames
  2074. )
  2075. ;;;
  2076. ;;; The value of the assoc number of <ename>
  2077. ;;;
  2078. (defun dl_val (v temp)
  2079.   (cdr(assoc v (entget temp)))
  2080. )
  2081. ;;;
  2082. ;;; List stripper : strips the last "v" members from the list
  2083. ;;;
  2084. (defun dl_lsu (lst v / m)
  2085.   (setq m 0 temp '())
  2086.   (repeat (- (length lst) v)
  2087.     (progn
  2088.       (setq temp (append temp (list (nth m lst))))
  2089.       (setq m (1+ m))
  2090.   ) )
  2091.   temp
  2092. )
  2093. ;;;
  2094. ;;; Bitwise DLINE endcap setting function.
  2095. ;;;
  2096. (defun endcap ()
  2097.   (initget "Auto Both End None Start")
  2098.   (setq dl:ecp (getkword 
  2099.     "\nDraw which endcaps?  Both/End/None/Start/<Auto>: "))
  2100.   (cond
  2101.     ((= dl:ecp "None")
  2102.       (setq dl:ecp 0)
  2103.     )
  2104.     ((= dl:ecp "Start")
  2105.       (setq dl:ecp 1)
  2106.     )
  2107.     ((= dl:ecp "End")
  2108.       (setq dl:ecp 2)
  2109.     )
  2110.     ((= dl:ecp "Both")
  2111.       (setq dl:ecp 3)
  2112.     )
  2113.     (T  ; Auto
  2114.       (setq dl:ecp 4)
  2115.     )
  2116.   )
  2117. )
  2118. ;;;
  2119. ;;; Set these defaults when loading the routine.
  2120. ;;;
  2121. (if (null dl:ecp) (setq dl:ecp 4))    ; default to auto endcaps
  2122. (if (null dl:snp) (setq dl:snp T))    ; default to snapping ON
  2123. (if (null dl:brk) (setq dl:brk T))    ; default to breaking ON
  2124. (if (null dl:osd) (setq dl:osd 0))    ; default to center alignment
  2125. ;;;
  2126. ;;; These are the c: functions.
  2127. ;;;
  2128. (defun c:dl () (dline))
  2129. (defun c:dline () (dline))
  2130.  
  2131. (princ "  DLINE loaded.")
  2132. (princ)
  2133.